home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / 3dhexash.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-22  |  3.3 KB  |  108 lines
  1.  
  2. {$r-}
  3. program polygoned_and_shaded_hexagon; { inclusief clipping test! }
  4. uses
  5.   crt,threedee;
  6. const
  7.   divd=128;
  8.   dist=200;
  9.   point:array[0..11,0..2] of integer=(
  10.     (-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
  11.     (-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
  12.     ( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));
  13.   planes:array[0..9,0..3] of byte=(
  14.     (0,1,7,6),(1,2,8,7),(9,8,2,3),(10,9,3,4),(10,4,5,11),
  15.     (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
  16. var
  17.   polyz:array[0..9] of integer;
  18.   pind:array[0..9] of byte;
  19.  
  20. { -------------------------------------------------------------------------- }
  21.  
  22. procedure quicksort(lo,hi:integer);
  23.  
  24. procedure sort(l,r:integer);
  25. var i,j,x,y:integer;
  26. begin
  27.   i:=l; j:=r; x:=polyz[(l+r) div 2];
  28.   repeat
  29.     while polyz[i]<x do inc(i);
  30.     while x<polyz[j] do dec(j);
  31.     if i<=j then begin
  32.       y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
  33.       y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y;
  34.       inc(i); dec(j);
  35.     end;
  36.   until i>j;
  37.   if l<j then sort(l,j);
  38.   if i<r then sort(i,r);
  39. end;
  40.  
  41. begin
  42.   sort(lo,hi);
  43. end;
  44.  
  45. { -------------------------------------------------------------------------- }
  46.  
  47. procedure rotate_cube;
  48. const xst=1; yst=2; zst=-3;
  49. var xp,yp,z:array[0..11] of integer; x,y,i,j,k:integer; n,Key,phix,phiy,phiz:byte;
  50. begin
  51.   phix:=0; phiy:=0; phiz:=0;
  52.   fillchar(xp,sizeof(xp),0);
  53.   fillchar(yp,sizeof(yp),0);
  54.   repeat
  55.     {retrace;}
  56.     setborder(10);
  57.     {
  58.     for n:=5 to 9 do
  59.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  60.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  61.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  62.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],0);
  63.     }
  64.     cls(virseg);
  65.     for n:=0 to 11 do begin
  66.       i:=(cosinus(phiy)*point[n,0]-sinus(phiy)*point[n,2]) div divd;
  67.       j:=(cosinus(phiz)*point[n,1]-sinus(phiz)*i) div divd;
  68.       k:=(cosinus(phiy)*point[n,2]+sinus(phiy)*point[n,0]) div divd;
  69.       x:=(cosinus(phiz)*i+sinus(phiz)*point[n,1]) div divd;
  70.       y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
  71.       z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd+cosinus(phix) div 3;
  72.       xp[n]:=160+sinus(phix)+(-x*dist) div (z[n]-dist);
  73.       yp[n]:=100+cosinus(phix) div 2+(-y*dist) div (z[n]-dist);
  74.     end;
  75.     for n:=0 to 9 do begin
  76.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  77.       pind[n]:=n;
  78.     end;
  79.     quicksort(0,9);
  80.     for n:=5 to 9 do
  81.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  82.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  83.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  84.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],polyz[n]+55);
  85.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  86.     setborder(0);
  87.     flip(virseg,vidseg);
  88.   until keypressed;
  89. end;
  90.  
  91. { -------------------------------------------------------------------------- }
  92.  
  93. var i:word;
  94. begin
  95.   asm mov ax,13h; int 10h; end;
  96.   getmem(virscr,64000);
  97.   virseg:=seg(virscr^);
  98.   cls(virseg);
  99.   for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
  100.   {for i:=1 to 150 do setpal(i,10+i div 5,30+i div 5,10+i div 5);}
  101.   for i:=1 to 150 do setpal(i,i div 4,i div 2,i div 4);
  102.   rotate_cube;
  103.   freemem(virscr,64000);
  104.   textmode(lastmode);
  105. end.
  106.  
  107. { a non-mode-x version }
  108.